home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol218 / updatper.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-11-30  |  13.2 KB  |  488 lines
  1. 100  REM UPDATPER Program.
  2. 110  REM Data Entry to the Persons File
  3. 120  REM By:  Melvin O. Duke.  Last Updated 19 February 1986.
  4. 200  REM Screen Definitions
  5. 210  WIDTH "scrn:", 80
  6. 220  SCREEN S1,S2,S3,S4
  7. 600  REM Titles
  8. 610  TITLE$ = "Update the Persons File"
  9. 620  TITLE$ = TITLE$ + " ON DISPLAY"
  10. 700  REM Terminate if not called from the Menu
  11. 710  IF DD.MENU$ <> "" THEN 770
  12. 720  COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
  13. 730  PRINT "Cannot run the"
  14. 740  PRINT TITLE$
  15. 750  PRINT "Program, unless selected from the MENU"
  16. 760  END
  17. 770  REM OK
  18. 1000  REM Produce the first screen
  19. 1010  KEY ON : CLS : KEY OFF
  20. 1020  REM Draw the outer double box
  21. 1030  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 1300
  22. 1040  REM Find the title location
  23. 1050  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  24. 1060  REM Draw the title box
  25. 1070  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 1500
  26. 1080  REM Print the title
  27. 1090  LOCATE 4,TITLE.POS : PRINT TITLE$
  28. 1100  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  29. 1230  REM Draw the Copyright box
  30. 1240  R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 1300
  31. 1250  REM Print the Copyright
  32. 1260  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  33. 1270  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  34. 1280  GOTO 1700
  35. 1300  REM subroutine to print a double box
  36. 1310  COLOR P
  37. 1320  FOR I = R1 + 1 TO R2 - 1
  38. 1330   LOCATE I, C1 : PRINT CHR$(186);
  39. 1340   LOCATE I, C2 : PRINT CHR$(186);
  40. 1350  NEXT I
  41. 1360  FOR J = C1 + 1 TO C2 - 1
  42. 1370   LOCATE R1, J : PRINT CHR$(205);
  43. 1380   LOCATE R2, J : PRINT CHR$(205);
  44. 1390  NEXT J
  45. 1400   LOCATE R1, C1 : PRINT CHR$(201);
  46. 1410   LOCATE R1, C2 : PRINT CHR$(187);
  47. 1420   LOCATE R2, C1 : PRINT CHR$(200);
  48. 1430   LOCATE R2, C2 : PRINT CHR$(188);
  49. 1440  COLOR W
  50. 1450  RETURN
  51. 1500  REM subroutine to print a single box
  52. 1510  COLOR B
  53. 1520  FOR I = R1 + 1 TO R2 - 1
  54. 1530   LOCATE I, C1 : PRINT CHR$(179);
  55. 1540   LOCATE I, C2 : PRINT CHR$(179);
  56. 1550  NEXT I
  57. 1560  FOR J = C1 + 1 TO C2 - 1
  58. 1570   LOCATE R1, J : PRINT CHR$(196);
  59. 1580   LOCATE R2, J : PRINT CHR$(196);
  60. 1590  NEXT J
  61. 1600   LOCATE R1, C1 : PRINT CHR$(218);
  62. 1610   LOCATE R1, C2 : PRINT CHR$(191);
  63. 1620   LOCATE R2, C1 : PRINT CHR$(192);
  64. 1630   LOCATE R2, C2 : PRINT CHR$(217);
  65. 1640  COLOR W
  66. 1650  RETURN
  67. 1700  REM ask user to press a key to continue
  68. 1710  LOCATE 25,1
  69. 1720  PRINT "Have Data Diskette(s) in Place, then Press any key to continue.";
  70. 1730  K$ = INKEY$ : IF K$ = "" THEN 1730
  71. 1740  KEY ON : CLS : KEY OFF
  72. 2000  REM UPDATPER Program Starts Here.
  73. 2010  OPEN DD.PERS$+"persfile" AS #1 LEN = 256
  74. 2020  FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$
  75. 2030  REM ask the user for input
  76. 2040  LOCATE 23,1 : PRINT SPACE$(79);
  77. 2050  LOCATE 23,1 : PRINT "(0 to quit, ? to locate unused record)";
  78. 2060  LOCATE 22,1 : PRINT SPACE$(79) : LOCATE 22,1
  79. 2070  INPUT "Enter Record Number of Person to Update"; REPLY$
  80. 2080  IF REPLY$ <> "?" THEN 2240
  81. 2090  REM Locate an unused record
  82. 2100  FOUND = 0 : IF REC.NO = 0 THEN REC.NO = 1
  83. 2110  FOR LOOK = REC.NO TO MAX.PER
  84. 2120   GET #1, LOOK
  85. 2130   LOCATE 15,1 : PRINT "Searching Record";LOOK;
  86. 2140   T1 = CVS(F1$)
  87. 2150   IF T1 > 0 THEN 2170
  88. 2160   FOUND = 1 : REC.NO = LOOK : LOOK = MAX.PER
  89. 2170  NEXT LOOK
  90. 2180  IF FOUND = 1 THEN 2330
  91. 2190  PRINT "Unable to find an unused record above record";REC.NO
  92. 2200  PRINT "Either start from record 1 or extend the file"
  93. 2210  PRINT "Press any key to continue"
  94. 2220  A$ = INKEY$ : IF A$ = "" THEN 2220
  95. 2230  GOTO 2030
  96. 2240  IF REPLY$ = "0" THEN 5920
  97. 2250  REC.NO = VAL(REPLY$)
  98. 2260  IF REC.NO < 1 OR REC.NO > MAX.PER THEN 2270 ELSE 2320
  99. 2270  PRINT : PRINT "Number is out of range"
  100. 2280  PRINT "Press any key to continue"
  101. 2290  A$ = INKEY$ : IF A$ = "" THEN 2290
  102. 2300  KEY ON : CLS : KEY OFF
  103. 2310  GOTO 2030
  104. 2320  GET #1, REC.NO
  105. 2330  REM Extract information from the file for use
  106. 2340  T1 = CVS(F1$)
  107. 2350  REM Disallow Update if Rec.no is Zero (never Created)
  108. 2360  IF T1 <> 0 THEN 2420
  109. 2370  LOCATE 22,1 : PRINT SPACE$(79);: LOCATE 23,1 : PRINT SPACE$(79);: LOCATE 22,1
  110. 2380  PRINT "Record Number is Zero.  Must run the CREATPER Program First."
  111. 2390  LOCATE 25,1 : PRINT "Press any key to continue";
  112. 2400  A$ = INKEY$ : IF A$ = "" THEN 2400
  113. 2410  GOTO 5920  'Close the Files and return to the Menu
  114. 2420  T2$ = F2$          'Surname
  115. 2430  T3$ = F3$          'Given Names
  116. 2440  FOR J = 1 TO LEN(F3$)-1
  117. 2450   IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
  118. 2460  NEXT J
  119. 2470  T4$ = F4$          'Sex
  120. 2480  IF LEFT$(T4$,1) = "M" THEN T4$ = "Male"
  121. 2490  IF LEFT$(T4$,1) = "F" THEN T4$ = "Female"
  122. 2500  T5 = CVS(F5$)      'Code
  123. 2510  T6 = CVS(F6$)      'Father's No.
  124. 2520  T7 = CVS(F7$)      'Mother's No.
  125. 2530  T8$ = F8$          'Birthdate
  126. 2540  T9$ = F9$
  127. 2550  T10$ = F10$
  128. 2560  T11$ = F11$
  129. 2570  T12$ = F12$        'Death Date
  130. 2580  T13$ = F13$
  131. 2590  T14$ = F14$
  132. 2600  T15$ = F15$
  133. 2610  T16$ = F16$        'Burial Date
  134. 2620  T17$ = F17$
  135. 2630  T18$ = F18$
  136. 2640  T19$ = F19$
  137. 2650  KEY ON : CLS : KEY OFF
  138. 2660  R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 1300  'Double box
  139. 2670  R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 3730  'Horizontal double
  140. 2680  LOCATE 2,3 : PRINT "Personal Information of:"
  141. 2690  R1 = 3 : C1 = 43 : R2 = 21 : C2 = 43 : GOSUB 3910  'Vertical Double
  142. 2700  LOCATE 4,3 : COLOR N : PRINT "Person:"; : COLOR O
  143. 2710  LOCATE 5,3 : PRINT "Record-number:";
  144. 2720  LOCATE 7,3 : PRINT "Surname:";
  145. 2730  LOCATE 9,3 : PRINT "Given-names:";
  146. 2740  LOCATE 11,3 : PRINT "Sex:";
  147. 2750  LOCATE 12,3 : PRINT "Code:";
  148. 2760  R1 = 13 : C1 = 1 : R2 =13 : C2 = 43 : GOSUB 3730  'Horizontal Double
  149. 2770  LOCATE 14,3 : COLOR N : PRINT "Person's Father:"; : COLOR O
  150. 2780  LOCATE 15,3 : PRINT "Record-number:";
  151. 2790  LOCATE 16,3 : PRINT "Name:";
  152. 2800  R1 = 17 : C1 = 1 : R2 = 17 : C2 = 43 : GOSUB 3820  'Horizontal Single
  153. 2810  LOCATE 18,3 : COLOR N : PRINT "Person's Mother:"; : COLOR O
  154. 2820  LOCATE 19,3 : PRINT "Record-number:";
  155. 2830  LOCATE 20,3 : PRINT "Name:";
  156. 2840  LOCATE 4,45 : COLOR N : PRINT "Person's Vital Statistics:"; : COLOR O
  157. 2850  LOCATE 6,45 : PRINT "Birth-date:";
  158. 2860  LOCATE 7,45 : PRINT "Birth-city:";
  159. 2870  LOCATE 8,45 : PRINT "Birth-county:";
  160. 2880  LOCATE 9,45 : PRINT "State/Country:";
  161. 2890  LOCATE 11,45 : PRINT "Death-date:";
  162. 2900  LOCATE 12,45 : PRINT "Death-city:";
  163. 2910  LOCATE 13,45 : PRINT "Death-county:";
  164. 2920  LOCATE 14,45 : PRINT "State/Country:";
  165. 2930  LOCATE 16,45 : PRINT "Burial-date:";
  166. 2940  LOCATE 17,45 : PRINT "Burial-city:";
  167. 2950  LOCATE 18,45 : PRINT "Burial-county:";
  168. 2960  LOCATE 19,45 : PRINT "State/Country:";
  169. 2970  GOSUB 2990 'To print the current information
  170. 2980  GOTO 4000 'For User Input
  171. 2990  REM Print the Information Currently Present
  172. 3000  LOCATE 2,28 : PRINT SPACE$(50);
  173. 3010  LOCATE 2,28 : COLOR W : PRINT LEFT$(T3$ + " " + T2$,50);
  174. 3020  LOCATE 6,8 : PRINT SPACE$(5);
  175. 3030  LOCATE 6,8 : COLOR G : PRINT T1;
  176. 3040  LOCATE 8,9 : PRINT SPACE$(20);
  177. 3050  LOCATE 8,9 : PRINT LEFT$(T2$,20);
  178. 3060  LOCATE 10,9 : PRINT SPACE$(30);
  179. 3070  LOCATE 10,9 : PRINT LEFT$(T3$,30);
  180. 3080  LOCATE 11,9 : PRINT SPACE$(7);
  181. 3090  LOCATE 11,9 : PRINT LEFT$(T4$,7);
  182. 3100  LOCATE 12,8 : PRINT SPACE$(5);
  183. 3110  LOCATE 12,8 : PRINT T5;
  184. 3120  LOCATE 15,18 : PRINT SPACE$(5);
  185. 3130  LOCATE 15,18 : PRINT T6;
  186. 3140  REM Obtain the Father's Record
  187. 3150  IF T6 = 0 THEN SN$ = " " : GN$ = " " : GOTO 3250
  188. 3160  GET #1, T6
  189. 3170  SN$ = F2$ : GN$ = F3$
  190. 3180  REM right-trim the names
  191. 3190  FOR J = 1 TO LEN(F2$)-1
  192. 3200   IF RIGHT$(SN$,1)=" "THEN SN$=LEFT$(SN$,LEN(SN$)-1) ELSE J=LEN(F2$)-1
  193. 3210  NEXT J
  194. 3220  FOR J = 1 TO LEN(F3$)-1
  195. 3230   IF RIGHT$(GN$,1)=" "THEN GN$=LEFT$(GN$,LEN(GN$)-1) ELSE J=LEN(F3$)-1
  196. 3240  NEXT J
  197. 3250  NM$ = SN$ + ", " + GN$
  198. 3260  IF SN$ = " " OR  GN$ = " " THEN NM$ = SN$ + " " + GN$
  199. 3270  IF SN$ = " " AND GN$ = " " THEN NM$ = " "
  200. 3280  LOCATE 16, 9 : PRINT SPACE$(33);
  201. 3290  LOCATE 16, 9 : PRINT LEFT$(NM$,33);
  202. 3300  LOCATE 19,18 : PRINT SPACE$(5);
  203. 3310  LOCATE 19,18 : PRINT T7;
  204. 3320  REM Obtain the Mother's Record
  205. 3330  IF T7 = 0 THEN SN$ = " " : GN$ = " " : GOTO 3430
  206. 3340  GET #1, T7
  207. 3350  SN$ = F2$ : GN$ = F3$
  208. 3360  REM right-trim the names
  209. 3370  FOR J = 1 TO LEN(F2$)-1
  210. 3380   IF RIGHT$(SN$,1)=" "THEN SN$=LEFT$(SN$,LEN(SN$)-1) ELSE J=LEN(F2$)-1
  211. 3390  NEXT J
  212. 3400  FOR J = 1 TO LEN(F3$)-1
  213. 3410   IF RIGHT$(GN$,1)=" "THEN GN$=LEFT$(GN$,LEN(GN$)-1) ELSE J=LEN(F3$)-1
  214. 3420  NEXT J
  215. 3430  NM$ = SN$ + ", " + GN$
  216. 3440  IF SN$ = " " OR  GN$ = " " THEN NM$ = SN$ + " " + GN$
  217. 3450  IF SN$ = " " AND GN$ = " " THEN NM$ = " "
  218. 3460  LOCATE 20, 9 : PRINT SPACE$(33);
  219. 3470  LOCATE 20, 9 : PRINT LEFT$(NM$,33);
  220. 3480  LOCATE 6,60 : PRINT SPACE$(11);
  221. 3490  LOCATE 6,60 : PRINT LEFT$(T8$,11);
  222. 3500  LOCATE 7,60 : PRINT SPACE$(18);
  223. 3510  LOCATE 7,60 : PRINT LEFT$(T9$,18);
  224. 3520  LOCATE 8,60 : PRINT SPACE$(16);
  225. 3530  LOCATE 8,60 : PRINT LEFT$(T10$,16);
  226. 3540  LOCATE 9,60 : PRINT SPACE$(16);
  227. 3550  LOCATE 9,60 : PRINT LEFT$(T11$,16);
  228. 3560  LOCATE 11,60 : PRINT SPACE$(11);
  229. 3570  LOCATE 11,60 : PRINT LEFT$(T12$,11);
  230. 3580  LOCATE 12,60 : PRINT SPACE$(18);
  231. 3590  LOCATE 12,60 : PRINT LEFT$(T13$,18);
  232. 3600  LOCATE 13,60 : PRINT SPACE$(16);
  233. 3610  LOCATE 13,60 : PRINT LEFT$(T14$,16);
  234. 3620  LOCATE 14,60 : PRINT SPACE$(16);
  235. 3630  LOCATE 14,60 : PRINT LEFT$(T15$,16);
  236. 3640  LOCATE 16,60 : PRINT SPACE$(11);
  237. 3650  LOCATE 16,60 : PRINT LEFT$(T16$,11);
  238. 3660  LOCATE 17,60 : PRINT SPACE$(18);
  239. 3670  LOCATE 17,60 : PRINT LEFT$(T17$,18);
  240. 3680  LOCATE 18,60 : PRINT SPACE$(16);
  241. 3690  LOCATE 18,60 : PRINT LEFT$(T18$,16);
  242. 3700  LOCATE 19,60 : PRINT SPACE$(16);
  243. 3710  LOCATE 19,60 : PRINT LEFT$(T19$,16); : COLOR W
  244. 3720  RETURN
  245. 3730  REM Subroutine to draw a double horizontal line.  Attach to double.
  246. 3740  COLOR P
  247. 3750  FOR J = C1 + 1 TO C2 - 1
  248. 3760   LOCATE R1,J : PRINT CHR$(205);
  249. 3770  NEXT J
  250. 3780  LOCATE R1,C1 : PRINT CHR$(204);
  251. 3790  LOCATE R1,C2 : PRINT CHR$(185);
  252. 3800  COLOR W
  253. 3810  RETURN
  254. 3820  REM Subroutine to draw a single horizontal line.  Attach to double.
  255. 3830  COLOR P
  256. 3840  FOR J = C1 + 1 TO C2 - 1
  257. 3850   LOCATE R1,J : PRINT CHR$(196);
  258. 3860  NEXT J
  259. 3870  LOCATE R1,C1 : PRINT CHR$(199);
  260. 3880  LOCATE R1,C2 : PRINT CHR$(182);
  261. 3890  COLOR W
  262. 3900  RETURN
  263. 3910  REM Subroutine to draw a double vertical line.  Attach to double.
  264. 3920  COLOR P
  265. 3930  FOR I = R1 + 1 TO R2 - 1
  266. 3940   LOCATE I,C1 : PRINT CHR$(186);
  267. 3950  NEXT I
  268. 3960  LOCATE R1,C1 : PRINT CHR$(203);
  269. 3970  LOCATE R2,C1 : PRINT CHR$(202);
  270. 3980  COLOR W
  271. 3990  RETURN
  272. 4000  REM Routines to Obtain information from the User
  273. 4010  LOCATE 22,1 : PRINT SPACE$(79);
  274. 4020  LOCATE 23,1 : PRINT SPACE$(79);
  275. 4030  LOCATE 24,1 : PRINT SPACE$(79);
  276. 4040  LOCATE 25,1 : PRINT SPACE$(79);
  277. 4050  LOCATE 24,1 : PRINT "('enter' to leave alone, '/ enter' to end record, or reply as shown.)";
  278. 4060  LOCATE 23,1
  279. 4070  INPUT "Enter the Record Number";REPLY$
  280. 4080  IF REPLY$ = "/" THEN 5560
  281. 4090  IF REPLY$ = "" THEN 4200
  282. 4100  IF ABS(VAL(REPLY$)) = ABS(T1) THEN 4170 ELSE 4110
  283. 4110  REM Prevent Change of Rec.no
  284. 4120  LOCATE 22,1 : PRINT SPACE$(79); : LOCATE 24,1 : PRINT SPACE$(79); : LOCATE 22,1
  285. 4130  PRINT "Cannot Change the Record Number to another number.";
  286. 4140  LOCATE 25,1 : PRINT "Press any key to continue";
  287. 4150  A$ = INKEY$ : IF A$ = "" THEN 4150
  288. 4160  GOTO 4000
  289. 4170  T1 = VAL(REPLY$)
  290. 4180  IF T1 < 1 THEN GOSUB 5960 : GOSUB 2990 : GOTO 5560  'Negative
  291. 4190  GOSUB 2990
  292. 4200  LOCATE 23,1 : PRINT SPACE$(79);
  293. 4210  REM Terminate record update if rec.no is negative
  294. 4220  IF T1 < 0 THEN 5560
  295. 4230  LOCATE 23,1
  296. 4240  INPUT "Enter the Person's Surname (all capital letters)";REPLY$
  297. 4250  IF REPLY$ = "/" THEN 5560
  298. 4260  IF REPLY$ = "" THEN 4290
  299. 4270  T2$ = REPLY$
  300. 4280  GOSUB 2990
  301. 4290  LOCATE 23,1 : PRINT SPACE$(79);
  302. 4300  LOCATE 23,1
  303. 4310  INPUT "Enter the Person's Given Names";REPLY$
  304. 4320  IF REPLY$ = "/" THEN 5560
  305. 4330  IF REPLY$ = "" THEN 4360
  306. 4340  T3$ = REPLY$
  307. 4350  GOSUB 2990
  308. 4360  LOCATE 23,1 : PRINT SPACE$(79);
  309. 4370  LOCATE 23,1
  310. 4380  INPUT "Enter the Person's Sex";REPLY$
  311. 4390  IF REPLY$ = "/" THEN 5560
  312. 4400  IF REPLY$ = "" THEN 4450
  313. 4410  T4$ = REPLY$
  314. 4420  IF LEFT$(REPLY$,1) = "m" OR LEFT$(REPLY$,1) = "M" THEN T4$ = "Male"
  315. 4430  IF LEFT$(REPLY$,1) = "f" OR LEFT$(REPLY$,1) = "F" THEN T4$ = "Female"
  316. 4440  GOSUB 2990
  317. 4450  LOCATE 23,1 : PRINT SPACE$(79);
  318. 4460  LOCATE 23,1
  319. 4470  INPUT "Enter the Person's Code";REPLY$
  320. 4480  IF REPLY$ = "/" THEN 5560
  321. 4490  IF REPLY$ = "" THEN 4520
  322. 4500  T5 = VAL(REPLY$)
  323. 4510  GOSUB 2990
  324. 4520  LOCATE 23,1 : PRINT SPACE$(79);
  325. 4530  LOCATE 23,1
  326. 4540  INPUT "Enter the Father's Record Number";REPLY$
  327. 4550  IF REPLY$ = "/" THEN 5560
  328. 4560  IF REPLY$ = "" THEN 4620
  329. 4570  T6 = VAL(REPLY$)
  330. 4580  IF T6 >= 0 AND T6 <= MAX.PER THEN 4600
  331. 4590  LOCATE 22,1 : PRINT "Number out of Range"; : GOTO 4520
  332. 4600  LOCATE 22,1 : PRINT SPACE$(79);
  333. 4610  GOSUB 2990
  334. 4620  LOCATE 23,1 : PRINT SPACE$(79);
  335. 4630  LOCATE 23,1
  336. 4640  INPUT "Enter the Mother's Record Number";REPLY$
  337. 4650  IF REPLY$ = "/" THEN 5560
  338. 4660  IF REPLY$ = "" THEN 4720
  339. 4670  T7 = VAL(REPLY$)
  340. 4680  IF T7 >= 0 AND T7 <= MAX.PER THEN 4700
  341. 4690  LOCATE 22,1 : PRINT "Number out of Range"; : GOTO 4620
  342. 4700  LOCATE 22,1 : PRINT SPACE$(79);
  343. 4710  GOSUB 2990
  344. 4720  LOCATE 23,1 : PRINT SPACE$(79);
  345. 4730  LOCATE 23,1
  346. 4740  INPUT "Enter the Person's Birth-date as: dd Mmm yyyy";REPLY$
  347. 4750  IF REPLY$ = "/" THEN 5560
  348. 4760  IF REPLY$ = "" THEN 4790
  349. 4770  RSET T8$ = REPLY$
  350. 4780  GOSUB 2990
  351. 4790  LOCATE 23,1 : PRINT SPACE$(79);
  352. 4800  LOCATE 23,1
  353. 4810  INPUT "Enter the Person's Birth-city";REPLY$
  354. 4820  IF REPLY$ = "/" THEN 5560
  355. 4830  IF REPLY$ = "" THEN 4860
  356. 4840  T9$ = REPLY$
  357. 4850  GOSUB 2990
  358. 4860  LOCATE 23,1 : PRINT SPACE$(79);
  359. 4870  LOCATE 23,1
  360. 4880  INPUT "Enter the Person's Birth-county";REPLY$
  361. 4890  IF REPLY$ = "/" THEN 5560
  362. 4900  IF REPLY$ = "" THEN 4930
  363. 4910  T10$ = REPLY$
  364. 4920  GOSUB 2990
  365. 4930  LOCATE 23,1 : PRINT SPACE$(79);
  366. 4940  LOCATE 23,1
  367. 4950  INPUT "Enter the Person's Birth-state or Country";REPLY$
  368. 4960  IF REPLY$ = "/" THEN 5560
  369. 4970  IF REPLY$ = "" THEN 5000
  370. 4980  T11$ = REPLY$
  371. 4990  GOSUB 2990
  372. 5000  LOCATE 23,1 : PRINT SPACE$(79);
  373. 5010  LOCATE 23,1
  374. 5020  INPUT "Enter the Person's Death-date as: dd Mmm yyyy";REPLY$
  375. 5030  IF REPLY$ = "/" THEN 5560
  376. 5040  IF REPLY$ = "" THEN 5070
  377. 5050  RSET T12$ = REPLY$
  378. 5060  GOSUB 2990
  379. 5070  LOCATE 23,1 : PRINT SPACE$(79);
  380. 5080  LOCATE 23,1
  381. 5090  INPUT "Enter the Person's Death-city";REPLY$
  382. 5100  IF REPLY$ = "/" THEN 5560
  383. 5110  IF REPLY$ = "" THEN 5140
  384. 5120  T13$ = REPLY$
  385. 5130  GOSUB 2990
  386. 5140  LOCATE 23,1 : PRINT SPACE$(79);
  387. 5150  LOCATE 23,1
  388. 5160  INPUT "Enter the Person's Death-county";REPLY$
  389. 5170  IF REPLY$ = "/" THEN 5560
  390. 5180  IF REPLY$ = "" THEN 5210
  391. 5190  T14$ = REPLY$
  392. 5200  GOSUB 2990
  393. 5210  LOCATE 23,1 : PRINT SPACE$(79);
  394. 5220  LOCATE 23,1
  395. 5230  INPUT "Enter the Person's Death-state or Country";REPLY$
  396. 5240  IF REPLY$ = "/" THEN 5560
  397. 5250  IF REPLY$ = "" THEN 5280
  398. 5260  T15$ = REPLY$
  399. 5270  GOSUB 2990
  400. 5280  LOCATE 23,1 : PRINT SPACE$(79);
  401. 5290  LOCATE 23,1
  402. 5300  INPUT "Enter the Person's Burial-date as: dd Mmm yyyy";REPLY$
  403. 5310  IF REPLY$ = "/" THEN 5560
  404. 5320  IF REPLY$ = "" THEN 5350
  405. 5330  RSET T16$ = REPLY$
  406. 5340  GOSUB 2990
  407. 5350  LOCATE 23,1 : PRINT SPACE$(79);
  408. 5360  LOCATE 23,1
  409. 5370  INPUT "Enter the Person's Burial-city";REPLY$
  410. 5380  IF REPLY$ = "/" THEN 5560
  411. 5390  IF REPLY$ = "" THEN 5420
  412. 5400  T17$ = REPLY$
  413. 5410  GOSUB 2990
  414. 5420  LOCATE 23,1 : PRINT SPACE$(79);
  415. 5430  LOCATE 23,1
  416. 5440  INPUT "Enter the Person's Burial-county";REPLY$
  417. 5450  IF REPLY$ = "/" THEN 5560
  418. 5460  IF REPLY$ = "" THEN 5490
  419. 5470  T18$ = REPLY$
  420. 5480  GOSUB 2990
  421. 5490  LOCATE 23,1 : PRINT SPACE$(79);
  422. 5500  LOCATE 23,1
  423. 5510  INPUT "Enter the Person's Burial-state or Country";REPLY$
  424. 5520  IF REPLY$ = "/" THEN 5560
  425. 5530  IF REPLY$ = "" THEN 5560
  426. 5540  T19$ = REPLY$
  427. 5550  GOSUB 2990
  428. 5560  REM Input is complete, now see if user wants to save the data
  429. 5570  LOCATE 24,1 : PRINT SPACE$(79);
  430. 5580  LOCATE 23,1 : PRINT SPACE$(79);
  431. 5590  LOCATE 23,1
  432. 5600  INPUT "Type s (save), m (more), or f (forget)";REPLY$
  433. 5610  IF LEFT$(REPLY$,1) = "m" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 4000
  434. 5620  IF LEFT$(REPLY$,1) = "M" THEN LOCATE 23,1 : PRINT SPACE$(79); : GOTO 4000
  435. 5630  IF LEFT$(REPLY$,1) = "f" THEN KEY ON : CLS : KEY OFF : GOTO 2030
  436. 5640  IF LEFT$(REPLY$,1) = "F" THEN KEY ON : CLS : KEY OFF : GOTO 2030
  437. 5650  IF LEFT$(REPLY$,1) = "s" THEN LOCATE 22,1 : PRINT SPACE$(79); : GOTO 5690
  438. 5660  IF LEFT$(REPLY$,1) = "S" THEN LOCATE 22,1 : PRINT SPACE$(79); : GOTO 5690
  439. 5670  LOCATE 22,1 : PRINT "Error in reply";
  440. 5680  GOTO 5580
  441. 5690  REM Routine to SAVE the newly updated record
  442. 5700  LSET F1$  = MKS$(T1)
  443. 5710  LSET F2$  = T2$
  444. 5720  LSET F3$  = T3$
  445. 5730  LSET F4$  = LEFT$(T4$,1)
  446. 5740  LSET F5$  = MKS$(T5)
  447. 5750  LSET F6$  = MKS$(T6)
  448. 5760  LSET F7$  = MKS$(T7)
  449. 5770  RSET F8$  = T8$
  450. 5780  LSET F9$  = T9$
  451. 5790  LSET F10$  = T10$
  452. 5800  LSET F11$  = T11$
  453. 5810  RSET F12$  = T12$
  454. 5820  LSET F13$  = T13$
  455. 5830  LSET F14$  = T14$
  456. 5840  LSET F15$  = T15$
  457. 5850  RSET F16$  = T16$
  458. 5860  LSET F17$  = T17$
  459. 5870  LSET F18$  = T18$
  460. 5880  LSET F19$  = T19$
  461. 5890  PUT #1, REC.NO
  462. 5900  KEY ON : CLS : KEY OFF
  463. 5910  GOTO 2030
  464. 5920  CLOSE #1
  465. 5930  KEY ON : CLS : KEY OFF : LOCATE 21,1
  466. 5940  PRINT "End of Program"
  467. 5950  RUN DD.MENU$+"menu"
  468. 5960  REM Blank out a negative record
  469. 5970  T2$ = ""
  470. 5980  T3$ = ""
  471. 5990  T4$ = ""
  472. 6000  T5 = 0
  473. 6010  T6 = 0
  474. 6020  T7 = 0
  475. 6030  T8$ = ""
  476. 6040  T9$ = ""
  477. 6050  T10$ = ""
  478. 6060  T11$ = ""
  479. 6070  T12$ = ""
  480. 6080  T13$ = ""
  481. 6090  T14$ = ""
  482. 6100  T15$ = ""
  483. 6110  T16$ = ""
  484. 6120  T17$ = ""
  485. 6130  T18$ = ""
  486. 6140  T19$ = ""
  487. 6150  RETURN
  488.